{-
 -  Separ, Type/ClsData.hs
 -
 -  Copyright (c) 2010 Dariusz Leniowski. All Rights Reserved.
 -
 -  Redistribution and use in source and binary forms, with or without 
 -  modification, are permitted provided that the following conditions 
 -  are met:
 -
 -  1. Redistributions of source code must retain the above copyright 
 -     notice, this list of conditions and the following disclaimer.
 -
 -  2. Redistributions in binary form must reproduce the above copyright 
 -     notice, this list of conditions and the following disclaimer 
 -     in the documentation and/or other materials provided with 
 -     the distribution.
 -
 -  3. The name of the author may not be used to endorse or promote 
 -     products derived from this software without specific prior 
 -     written permission.
 -
 -  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 -  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 -  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 
 -  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL 
 -  THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, 
 -  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 
 -  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 
 -  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 
 -  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 
 -  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 
 -  IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
 -  POSSIBILITY OF SUCH DAMAGE.
 -
 -}

{-# LANGUAGE TypeSynonymInstances #-}

-- Module ClsData
-- Autogenerated, do not edit

module Type.ClsData where

import Data.Bits
import qualified Data.List as List
import qualified Data.Set as Set
import Type.Base
import Type.ClsType

----------------------------------------------
--  some operators for types 
----------------------------------------------

infixl 5 <-- 
infixr 5 --> 
infixl 6 <<< 
infixr 6 >>> 
infixl 4 `is` 
infixl 8 `sp` 
infixl 8 `gp` 
infix  9 `val` 
infixl 7 `inf` 
infixl 7 `sup` 

class ConvertibleToType a where
	toType :: a -> Type
instance ConvertibleToType Int where
	toType i = Ref i
instance ConvertibleToType String where
	toType s = Cls $ read s
instance ConvertibleToType Type where
	toType ty = ty

(<--) :: (ConvertibleToType a, ConvertibleToType b) => a -> b -> Type
r <-- a = Lam False (toType a) (toType r)
(-->) :: (ConvertibleToType a, ConvertibleToType b) => a -> b -> Type
a --> r = Lam True (toType a) (toType r)
(>>>) :: (ConvertibleToType a, ConvertibleToType b) => a -> b -> Type
x >>> f = App True (toType f) (toType x)
(<<<) :: (ConvertibleToType a, ConvertibleToType b) => a -> b -> Type
f <<< x = App False (toType f) (toType x)

t :: Int -> (Int,Type)
t i = (i,Cls clsThing)
is :: ConvertibleToType a => (Int,Type) -> a -> (Int,Type)
is (i,_) ty = (i,toType ty)
sp :: ConvertibleToType a => a -> (String,Type) -> Type
sp ty (s,p) = pSet (toType ty) s p
val :: ConvertibleToType a => String -> a -> (String,Type)
val s p = (s,toType p)
gp :: ConvertibleToType a => a -> String -> Type
gp ty s = PGet (toType ty) s
sup :: (ConvertibleToType a, ConvertibleToType b) => a -> b -> Type
sup a b = Lca (toType a) (toType b)
inf :: (ConvertibleToType a, ConvertibleToType b) => a -> b -> Type
inf a b = Gcd (toType a) (toType b)

var :: ConvertibleToType a => [(Int,Type)] -> a -> Type
var ls ty = foldr (\(i,t1) t2 -> Var i (Cls clsNothing,t1) TT t2) (toType ty) ls


----------------------------------------------
--  relations on classes
----------------------------------------------

clsGetSubclasses :: ClsType -> [ClsType]
clsGetSubclasses c@(C 0 0) = error $ "illegal class: " ++ show c
clsGetSubclasses   (C 1 0) = map clsIToCls [3, 4, 5, 6]
clsGetSubclasses   (C 2 0) = map clsIToCls []
clsGetSubclasses   (C 3 0) = map clsIToCls [2]
clsGetSubclasses   (C 4 0) = map clsIToCls [2]
clsGetSubclasses   (C 5 0) = map clsIToCls [3]
clsGetSubclasses   (C 6 0) = map clsIToCls [3]
clsGetSubclasses c@(C _ 0) = error $ "illegal class: " ++ show c
clsGetSubclasses   (C 0 e) = map clsIToCls $ clsEToIs e
clsGetSubclasses c@(C _ _) = error $ "illegal class: " ++ show c

clsGetSuperclasses :: ClsType -> [ClsType]
clsGetSuperclasses c@(C 0 0) = error $ "illegal class: " ++ show c
clsGetSuperclasses   (C 1 0) = map clsIToCls []
clsGetSuperclasses   (C 2 0) = map clsIToCls [3, 4]
clsGetSuperclasses   (C 3 0) = map clsIToCls [1, 5, 6]
clsGetSuperclasses   (C 4 0) = map clsIToCls [1]
clsGetSuperclasses   (C 5 0) = map clsIToCls [1]
clsGetSuperclasses   (C 6 0) = map clsIToCls [1]
clsGetSuperclasses c@(C _ 0) = error $ "illegal class: " ++ show c
clsGetSuperclasses   (C 0 e) = 
	let f i = clsIsSubclassOf (C 0 e) (C i 0) in
	map clsIToCls $ List.filter f clsGetAllI
clsGetSuperclasses c@(C _ _) = error $ "illegal class: " ++ show c

clsGetAllSuperclasses :: ClsType -> [ClsType]
clsGetAllSuperclasses c = Set.toList $ f Set.empty $ clsGetSuperclasses c where
	f out []  = out
	f out inp = 
		let sinp = Set.fromList inp in
		let inp' = Set.toList $ Set.difference sinp out in 
		f (Set.union out sinp) $ List.concatMap clsGetSuperclasses inp'

clsGetValues :: ClsType -> Type -> [Type]
clsGetValues _ _ = []

clsGetSubtype :: ClsType -> Type -> MM Type
clsGetSubtype cls org | clsIsThing cls = fail $ ""
clsGetSubtype cls org = MM $ \ctx -> 
	map (\ty -> (ctx,ty)) $ concatMap (flip clsGetValues org) $ cls:(clsGetAllSuperclasses cls)

clsGetProperties :: String -> ClsType -> Type -> [Type]
clsGetProperties _ _ _ = []

clsGetProperty :: String -> ClsType -> Type -> MM Type
clsGetProperty s cls org = MM $ \ctx -> 
	map (\ty -> (ctx,ty)) $ 
		concatMap (flip (clsGetProperties s) org) $ 
			cls:(clsGetAllSuperclasses cls)

clsGetComments :: ClsType -> [String]
clsGetComments _ = []

clsGetAnnotations :: ClsType -> [(String,String)]
clsGetAnnotations _ = []

-- isSubclassOf(x,x)
-- isSubclassOf(Int,Number)
clsIsSubclassOf :: ClsType -> ClsType -> Bool
clsIsSubclassOf (C 0 0) (C 0 0) = 
	error $ "illegal classes: (C 0 0) (C 0 0)"
clsIsSubclassOf (C 0 0) _ = error $ "illegal class: (C 0 0)"
clsIsSubclassOf _ (C 0 0) = error $ "illegal class: (C 0 0)"
clsIsSubclassOf (C 1 0) (C 1 0) = True
clsIsSubclassOf (C 2 0) (C 2 0) = True
clsIsSubclassOf (C 3 0) (C 3 0) = True
clsIsSubclassOf (C 3 0) (C 4 0) = False
clsIsSubclassOf (C 4 0) (C 4 0) = True
clsIsSubclassOf (C 4 0) (C 3 0) = False
clsIsSubclassOf (C 4 0) (C 1 0) = True
clsIsSubclassOf (C 1 0) (C _ 0) = False
clsIsSubclassOf (C _ 0) (C 1 0) = True
clsIsSubclassOf (C 2 0) (C _ 0) = True
clsIsSubclassOf (C _ 0) (C 2 0) = False
clsIsSubclassOf (C 3 0) (C _ 0) = True
clsIsSubclassOf (C _ 0) (C 3 0) = False
clsIsSubclassOf (C 4 0) (C _ 0) = False
clsIsSubclassOf (C i1 0) (C i2 0) = 
	let e1 = clsIToE i1 in
	let e2 = clsIToE i2 in
	e1 .&. e2 == e2
clsIsSubclassOf (C i1 0) (C 0 e2) = let e1 = clsIToE i1 in e1 .&. e2 == e2
clsIsSubclassOf (C 0 e1) (C i2 0) = let e2 = clsIToE i2 in e1 .&. e2 == e2
clsIsSubclassOf (C 0 e1) (C 0 e2) = e1 .&. e2 == e2
clsIsSubclassOf c1@(C _ _) c2@(C _ _) = 
	error $ "illegal classes: " ++ show c1 ++ " and " ++ show c2

clsIsProperSubclassOf :: ClsType -> ClsType -> Bool
clsIsProperSubclassOf c1 c2 = clsIsSubclassOf c1 c2 && (c1 /= c2)

